home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #034 (19xx)(Amiga User Group Deutschland e.V.).zip
/
Franz PD Disk #034 (19xx)(Amiga User Group Deutschland e.V.).adf
/
Briefumschlag
/
Briefumschlag
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1987-05-06
|
9KB
|
376 lines
REM ****************************
REM * Briefumschläge drucken ! *
REM ** **
REM * start: 10 Juni 1989 *
REM * ende: 11 Juni 1989 *
REM ****************************
SCREEN 2,640,210,3,2
LIBRARY "graphics.library"
WINDOW 1," *** Briefumschläge drucken Perfekt !! -- © Juni 1989 by Eumelsoft ***",,16,2
PALETTE 4,0.4,0.6,0
MENU 1,0,1,"Projekt"
MENU 1,1,1,"Information"
MENU 1,2,1,"Verlassen"
MENU 2,0,1,"Briefformat"
MENU 2,1,1,"162 x 114 MM"
MENU 2,2,1,"220 x 110 MM"
MENU 3,0,1,"Empfänger"
MENU 3,1,1,"laden"
MENU 3,2,1,"sichern"
MENU 3,3,1,"löschen"
MENU 3,4,1,"ändern"
MENU 3,5,1,"eingeben"
MENU 4,0,1,"Absender"
MENU 4,1,1,"laden"
MENU 4,2,1,"sichern"
MENU 4,3,1,"löschen"
MENU 4,4,1,"ändern"
MENU 4,5,1,"eingeben"
MENU 5,0,1,"Briefdruck"
MENU 5,1,1,"Brief drucken !"
GOSUB anfang
start:
ON MENU GOSUB menukontrolle
MENU ON
GOTO start
menukontrolle:
menutitel=MENU(0)
menunr=MENU(1)
ON menutitel GOTO projekt,brieff,empf,abse,druck
projekt:
ON menunr GOSUB anfang,ende
RETURN
brieff:
ON menunr GOSUB brief1,brief2
RETURN
empf:
ON menunr GOSUB emladen,emsichern,emloeschen,emaendern,emein
RETURN
abse:
ON menunr GOSUB abladen,absichern,abloeschen,abaendern,abein
RETURN
druck:
ON menunr GOSUB drucken
RETURN
anfang:
x2=500:y2=140
LINE (13,13)-(640,180),0,bf
LINE (20,20)-(x2+10,y2+10),2,bf
LINE (15,15)-(x2,y2),1,bf
LINE (14,14)-(x2+1,y2+1),2,b
POKE WINDOW (8)+56,7
COLOR 2,1:LOCATE 5,10
CALL setdrmd&(WINDOW(8),0)
schr$="*** Briefumschläge drucken Perfekt ! ***"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$))
POKE WINDOW (8)+56,4:LOCATE 7,7
schr$="Das Programm ist vollständig Public Domain !"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 8,7
schr$="Es dient zum einfachen, aber kompfortabelen bedrucken"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 9,7
schr$="von Briefumschlägen der größen:"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 11,7
COLOR 3,2:schr$="162 x 114 Millimeter und 220 x 110 Millimeter"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 13,7
COLOR 2,1:schr$="Das Programm wurde programmiert von:"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 15,18
COLOR 3,1:POKE WINDOW (8)+56,2:schr$="Martin Jochimczyk"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$)):LOCATE 16,18
schr$="Am Sande 12":CALL text(WINDOW(8),SADD(schr$),LEN(schr$))
POKE WINDOW (8)+56,3:LOCATE 17,18
schr$="2723 Scheeßel":CALL text(WINDOW(8),SADD(schr$),LEN(schr$))
CALL setdrmd&(WINDOW(8),1)
POKE WINDOW (8)+56,0:COLOR 1,0
GOTO start
ende:
x2=500:y2=140
LINE (13,13)-(640,180),0,bf
LINE (20,20)-(x2+10,y2+10),2,bf
LINE (15,15)-(x2,y2),1,bf
LINE (14,14)-(x2+1,y2+1),2,b
POKE WINDOW (8)+56,4
COLOR 2,1:LOCATE 11,20
CALL setdrmd&(WINDOW(8),0)
schr$="Auf Wiedersehen ... !"
CALL text(WINDOW(8),SADD(schr$),LEN(schr$))
LIBRARY CLOSE
FOR i=1 TO 1000:NEXT
SYSTEM
briefmalen:
LINE (13,13)-(640,180),0,bf
LINE (20,20)-(x2+10,y2+10),2,bf
LINE (15,15)-(x2,y2),1,bf
LINE (14,14)-(x2+1,y2+1),2,b
GOSUB schreiben
RETURN
schreiben:
COLOR 2,1
IF x2=415 THEN q=14:w=2:z=11
IF x2=560 THEN q=14:w=2:z=25
LOCATE q-1,w+(LEN(emvorna$)+LEN(emnachna$)+z):PRINT "An"
LOCATE q,w+(LEN(emvorna$)+LEN(emnachna$)+z):PRINT eman$
LOCATE q+1,w+(LEN(emvorna$)+LEN(emnachna$)+z):PRINT emvorna$;" ";emnachna$
LOCATE q+2,w+(LEN(emvorna$)+LEN(emnachna$)+z):PRINT emstra$;" ";emhausnr$
POKE WINDOW(8)+56,3
LOCATE q+4,w+(LEN(emvorna$)+LEN(emnachna$)+z):PRINT empost$;" ";emstadt$
POKE WINDOW(8)+56,0
LOCATE q-10,w+3:PRINT "Abs.:"
LOCATE q-9,w+3:PRINT abvorna$;" ";abnachna$
LOCATE q-8,w+3:PRINT abstra$;" ";abhausnr$
POKE WINDOW (8)+56,3
LOCATE q-7,w+3:PRINT abpost$;" ";abstadt$
POKE WINDOW (8)+56,0
RETURN
brief1:
x2=415:y2=161
GOSUB briefmalen
RETURN
brief2:
x2=560:y2=155
GOSUB briefmalen
RETURN
emladen:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Empfängeradresseladen:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".emadr"
OPEN file$ FOR APPEND AS #2
l=LOF(2)
CLOSE #2
IF l=0 THEN isnicht
OPEN "I",#2,file$
WHILE NOT EOF(2)
INPUT #2,eman$,emvorna$,emnachna$,emstra$
INPUT #2,emhausnr$,empost$,emstadt$
WEND
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Ich habe die Daten"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
isnicht:
COLOR 4:PRINT:PRINT
PRINT "Die Datei existiert nicht !!"
PRINT:PRINT "Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
GOTO start
emsichern:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Empfängeradressesichern:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".emadr"
OPEN file$ FOR OUTPUT AS #2
WRITE #2,eman$,emvorna$,emnachna$
WRITE #2,emstra$,emhausnr$,empost$,emstadt$
CLOSE #2
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Die Daten sind gesichert !"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
emloeschen:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Empfängeradresselöschen:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".emadr"
OPEN file$ FOR APPEND AS #2
l=LOF(2)
CLOSE #2
IF l=0 THEN isnicht
KILL file$
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Die Daten sind gelöscht !"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
emein:
WINDOW 3,"",(100,41)-(500,120),0,2
COLOR 4:POKE WINDOW (8)+56,4:POKE WINDOW (8)+10,2
CALL setdrmd&(WINDOW(8),0)
PRINT "Empfängeradresseeingabe:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT "An: ";eman$
LINE INPUT "Vorname: ";emvorna$
LINE INPUT "Nachnahme: ";emnachna$
LINE INPUT "Straße: ";emstra$
LINE INPUT "Hausnummer: ";emhausnr$
LINE INPUT "Postleitzahl: ";empost$
LINE INPUT "Ort/Stadt: : ";emstadt$
POKE WINDOW (8)+10,0
WINDOW CLOSE 3
RETURN
emaendern:
WINDOW 3,"",(40,41)-(600,130),0,2
COLOR 4:POKE WINDOW (8)+56,4
CALL setdrmd&(WINDOW(8),0)
PRINT "Empfängeradresseändern:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
PRINT "An: ";eman$
PRINT "Vorname: ";emvorna$
PRINT "Nachnahme: ";emnachna$
PRINT "Straße: ";emstra$
PRINT "Hausnummer: ";emhausnr$
PRINT "Postleitzahl: ";empost$
PRINT "Ort/Stadt: ";emstadt$
LOCATE 3,35:LINE INPUT"An: ";eman$
LOCATE 4,35:LINE INPUT"Vorname: ";emvorna$
LOCATE 5,35:LINE INPUT"Nachnahme: ";emnachna$
LOCATE 6,35:LINE INPUT"Straße: ";emstra$
LOCATE 7,35:LINE INPUT"Hausnummer: ";emhausnr$
LOCATE 8,35:LINE INPUT"Postleitzahl: ";empost$
LOCATE 9,35:LINE INPUT"Ort/Stadt: ";emstadt$
WINDOW CLOSE 3
RETURN
abein:
WINDOW 3,"",(100,41)-(500,120),0,2
COLOR 4:POKE WINDOW (8)+56,4:POKE WINDOW (8)+10,2
CALL setdrmd&(WINDOW(8),0)
PRINT "Absenderadresseeingabe:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT "Vorname: ";abvorna$
LINE INPUT "Nachnahme: ";abnachna$
LINE INPUT "Straße: ";abstra$
LINE INPUT "Hausnummer: ";abhausnr$
LINE INPUT "Postleitzahl: ";abpost$
LINE INPUT "Ort/Stadt: : ";abstadt$
POKE WINDOW (8)+10,0
WINDOW CLOSE 3
RETURN
abladen:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Absenderadresseladen:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".abadr"
OPEN file$ FOR APPEND AS #1
l=LOF(1)
CLOSE #1
IF l=0 THEN isnicht
OPEN "I",#1,file$
WHILE NOT EOF(1)
INPUT #1,abvorna$,abnachna$,abstra$
INPUT #1,abhausnr$,abpost$,abstadt$
WEND
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Ich habe die Daten"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
absichern:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Absenderadressesichern:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".abadr"
OPEN file$ FOR OUTPUT AS #1
WRITE #1,abvorna$,abnachna$
WRITE #1,abstra$,abhausnr$,abpost$,abstadt$
CLOSE #1
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Die Daten sind gesichert !"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
abaendern:
WINDOW 3,"",(40,41)-(600,130),0,2
COLOR 4:POKE WINDOW (8)+56,4
CALL setdrmd&(WINDOW(8),0)
PRINT "Absenderadresseändern:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
PRINT "Vorname: ";abvorna$
PRINT "Nachnahme: ";abnachna$
PRINT "Straße: ";abstra$
PRINT "Hausnummer: ";abhausnr$
PRINT "Postleitzahl: ";abpost$
PRINT "Ort/Stadt: ";abstadt$
LOCATE 3,35:LINE INPUT"Vorname: ";abvorna$
LOCATE 4,35:LINE INPUT"Nachnahme: ";abnachna$
LOCATE 5,35:LINE INPUT"Straße: ";abstra$
LOCATE 6,35:LINE INPUT"Hausnummer: ";abhausnr$
LOCATE 7,35:LINE INPUT"Postleitzahl: ";abpost$
LOCATE 8,35:LINE INPUT"Ort/Stadt: ";abstadt$
WINDOW CLOSE 3
RETURN
abloeschen:
WINDOW 3,"",(100,41)-(500,90),0,2
COLOR 4:POKE WINDOW (8)+56,4:CALL setdrmd&(WINDOW(8),0)
PRINT "Absenderadresselöschen:":COLOR 1:PRINT
CALL setdrmd&(WINDOW(8),1):POKE WINDOW(8)+56,0
LINE INPUT"Dateiname: ";datnam$
file$=datnam$+".abadr"
OPEN file$ FOR APPEND AS 1
l=LOF(1)
CLOSE 1
IF l=0 THEN isnicht
KILL file$
COLOR 4:PRINT:PRINT
PRINT "Alles klar! Die Daten sind gelöscht !"
PRINT:PRINT"Bitte drücke die linke Maustaste"
CALL wartemaus
WINDOW CLOSE 3
RETURN
drucken:
IF x2=415 THEN z=11
IF x2=560 THEN z=25
OPEN "par:" FOR OUTPUT AS #3
PRINT #3,""
PRINT #3,SPC(3);"Abs.:"
PRINT #3,SPC(3);abvorna$;" ";abnachna$
PRINT #3,SPC(3);abstra$;" ";abhausnr$
PRINT #3,SPC(3);CHR$(27);"-";CHR$(1);abpost$;" ";abstadt$;CHR$(27);"-";CHR$(0)
FOR i=1 TO 5:PRINT #3,"":NEXT
PRINT #3,CHR$(27);"E"
PRINT#3,SPC(2+LEN(emvorna$)+LEN(emnachna$)+z);"An"
PRINT#3,SPC(2+LEN(emvorna$)+LEN(emnachna$)+z);eman$
PRINT#3,SPC(2+LEN(emvorna$)+LEN(emnachna$)+z);emvorna$;" ";emnachna$
PRINT#3,SPC(2+LEN(emvorna$)+LEN(emnachna$)+z);emstra$;" ";emhausnr$
PRINT #3,""
PRINT#3,SPC(2+LEN(emvorna$)+LEN(emnachna$)+z);CHR$(27);"-";CHR$(1);empost$;" ";emstadt$;CHR$(27);"-";CHR$(0)
PRINT #3,CHR$(27);"F"
CLOSE #3
RETURN
SUB wartemaus STATIC
maus=MOUSE(0)
loop:
SLEEP
IF MOUSE(0)=0 THEN loop
END SUB